home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr42 / vocshow2.zip / COMPRESS.PKG < prev    next >
Text File  |  1993-06-08  |  5KB  |  120 lines
  1. -- Copyright 1992 by Tom Moran.  May be used by anyone for any purpose.
  2.  
  3. with SB_Samples,
  4.      System;
  5. use SB_Samples;
  6.  
  7. package body Compress is
  8.  
  9.   -- sound sample levels range from 0 .. 255, so differences between
  10.   -- successive samples can range from -255 .. +255
  11.   type Differences is range - 255 .. 255;
  12.   subtype Levels is Differences range 0 .. 255;
  13.  
  14.   type Adaptive_Step_Indices is range 0 .. 3;
  15.   for Adaptive_Step_Indices'Size use 2;
  16.   Doubled_Step_Size: constant array (Adaptive_Step_Indices) of Differences
  17.     := (2, 5, 10, 20); -- steps are 1  2.5  5  10
  18.  
  19.   -- max of 7 steps at max of 10 units/step
  20.   type Delta_Approxs is range - 70 .. 70;
  21.   for Delta_Approxs'Size use 8;
  22.  
  23.   -- given a current difference and a current adaptive step size,
  24.   -- we need to know what 4 bit packed nibble to emit, by what delta
  25.   -- that changes the current approximation, and what the new step
  26.   -- size will be.  The answers are packed into 16 bits so we need a
  27.   -- lookup array of 511 differences *4 step sizes*2 bytes = 4088 bytes
  28.   type Process_One_Results is
  29.     record
  30.       Delta_Approx  : Delta_Approxs;
  31.       Nibble        : SB_Samples.Packed_Sound_Nibbles;
  32.       New_Step_Index: Adaptive_Step_Indices;
  33.     end record;
  34.   for Process_One_Results use
  35.     record
  36.       Delta_Approx   at 0 range 0 .. 7;
  37.       Nibble         at 0 range 8 .. 11;
  38.       New_Step_Index at 0 range 12 .. 13;
  39.     end record;
  40.   for Process_One_Results'Size use 16;
  41.  
  42.   Process_One_Result_Array: array (Differences, Adaptive_Step_Indices)
  43.     of Process_One_Results;
  44.  
  45.   Current_Approx: Levels := 128;
  46.   Current_Step_Index: Adaptive_Step_Indices := Adaptive_Step_Indices'First;
  47.  
  48.   function Min(Left, Right : in Integer) return Integer is
  49.   begin if Left < Right then return Left;else return Right;end if;end Min;
  50.  
  51.   procedure Pack(Unpacked_Source_Address:in     System.Address;
  52.                  Sound_Length           :in     Natural;
  53.                  Packed_Target          :   out SB_Samples.Packed_Sounds) is
  54.     pragma All_Checks(Off); -- allow garbage in to produce garbage out
  55.     Unpacked_Source:SB_Samples.Unpacked_Sounds
  56.     -- static array bounds generate better code with my compiler
  57.                       (SB_Samples.Sound_Indices);
  58.     for Unpacked_Source use at Unpacked_Source_Address;
  59.     J           : Integer := Unpacked_Source'First;
  60.     Pair_Count  : constant Integer:=Min(Sound_Length/2,Packed_Target'Length);
  61.     This_Result : Process_One_Results;
  62.     Left_Nibble,
  63.     Right_Nibble: SB_Samples.Packed_Sound_Nibbles;
  64.   begin
  65.     for I in Packed_Target'First .. Packed_Target'First+Pair_Count-1 loop
  66.       This_Result
  67.         := Process_One_Result_Array(Levels(Unpacked_Source(J))-Current_Approx,
  68.                                     Current_Step_Index);
  69.       Current_Approx := Current_Approx + Differences(This_Result.Delta_Approx);
  70.       Left_Nibble := This_Result.Nibble;
  71.       This_Result
  72.         :=Process_One_Result_Array(Levels(Unpacked_Source(J+1))-Current_Approx,
  73.                                     This_Result.New_Step_Index);
  74.       Current_Approx := Current_Approx + Differences(This_Result.Delta_Approx);
  75.       Right_Nibble := This_Result.Nibble;
  76.       Current_Step_Index := This_Result.New_Step_Index;
  77.       Packed_Target(I) := Packed_Sound_Pairs(Left_Nibble)*16
  78.                          +Packed_Sound_Pairs(Right_Nibble);
  79.       J := J + 2;
  80.     end loop;
  81.   end Pack;
  82.  
  83.   procedure Initialize is     -- fill in process_one_result_array
  84.     Magnitude: Differences range 0 .. Differences'Last;
  85.     This_Result: Process_One_Results;
  86.   begin
  87.     for Step_Index in Adaptive_Step_Indices loop
  88.       for Diff in Differences loop
  89.         Magnitude := (abs (Diff) * 2) / Doubled_Step_Size(Step_Index);
  90.         if Magnitude > 7 then
  91.           Magnitude := 7;
  92.         end if;
  93.         This_Result.Delta_Approx
  94.           := Delta_Approxs((Magnitude*Doubled_Step_Size(Step_Index))/2);
  95.         This_Result.Nibble := SB_Samples.Packed_Sound_Nibbles(Magnitude);
  96.         if Diff < 0 then
  97.           This_Result.Delta_Approx := - This_Result.Delta_Approx;
  98.           This_Result.Nibble := This_Result.Nibble + 8;
  99.         end if;
  100.         This_Result.New_Step_Index := Step_Index;
  101.         if Magnitude = 0 then
  102.           if Step_Index > Adaptive_Step_Indices'First then
  103.             This_Result.New_Step_Index
  104.               := Adaptive_Step_Indices'Pred(Step_Index);
  105.           end if;
  106.         elsif Magnitude > 4 then
  107.           if Step_Index < Adaptive_Step_Indices'Last then
  108.             This_Result.New_Step_Index
  109.               := Adaptive_Step_Indices'Succ(Step_Index);
  110.           end if;
  111.         end if;
  112.         Process_One_Result_Array(Diff, Step_Index) := This_Result;
  113.       end loop; -- differences
  114.     end loop; -- adaptive_step_indices
  115.   end Initialize;
  116.  
  117. begin
  118.   Initialize;
  119. end Compress;
  120.